home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / vgacodng / part09_a.pas < prev    next >
Pascal/Delphi Source File  |  1996-12-15  |  3KB  |  119 lines
  1. program Sternen_Effekt;
  2.  
  3. uses crt;
  4.  
  5. const StarNo = 1000; { 1000 Sterne }
  6.  
  7. type Star3D = record
  8.                 x,y,z : integer;
  9.               end;
  10.      Star2D = record
  11.                 x,y : integer;
  12.               end;
  13.      Star2DArray = array[1..StarNo] of Star2D;
  14.  
  15. var Stars3D : array[1..StarNo] of Star3D;
  16.     Stars2D : Star2DArray;
  17.     Backup  : Star2DArray;
  18.     ZAdd,n  : integer;
  19.  
  20. procedure InitStars;
  21. var n : integer;
  22.  
  23. begin
  24.   for n := 1 to StarNo do begin
  25.     repeat
  26.       Stars3D[n].x := random(640) - 320;
  27.       Stars3D[n].y := random(400) - 200;
  28.     until (Stars3D[n].x <> 0) and (Stars3D[n].y <> 0);
  29.     Stars3D[n].z := random(StarNo);
  30.   end;
  31. end;
  32.  
  33. procedure Calc_2Dto3D;
  34. var n : integer;
  35.  
  36. begin
  37.   for n := 1 to StarNo do begin
  38.     Stars2D[n].x := Stars3D[n].x * 128 div Stars3D[n].z + 160;
  39.     Stars2D[n].y := Stars3D[n].y * 128 div Stars3D[n].z + 100;
  40.   end;
  41. end;
  42.  
  43. procedure DrawStars;
  44. var n : integer;
  45.  
  46. begin
  47.   for n := 1 to StarNo do if (Stars2D[n].x > 0) and (Stars2D[n].x < 320)
  48.                              and (Stars2D[n].y > 0) and (Stars2D[n].y < 200)
  49.                              and (Stars3D[n].z < 500)
  50.                           then mem[$A000:Stars2D[n].y*320+Stars2D[n].x] :=
  51.                               63-Stars3D[n].z div 10;
  52. end;
  53.  
  54. procedure ClearStars;
  55. var n : integer;
  56.  
  57. begin
  58.   for n := 1 to StarNo do if (Backup[n].x > 0) and (Backup[n].x < 320)
  59.                              and (Backup[n].y > 0) and (Backup[n].y < 200)
  60.                           then mem[$A000:Backup[n].y*320+Backup[n].x] := 0;
  61. end;
  62.  
  63. procedure MoveStars;
  64. var n : integer;
  65.  
  66. begin
  67.   for n := 1 to StarNo do begin
  68.     inc(Stars3D[n].z,ZAdd);
  69.     if Stars3D[n].z < 1 then inc(Stars3D[n].z,StarNo);
  70.     if Stars3D[n].z > StarNo then dec(Stars3D[n].z,StarNo);
  71.   end;
  72. end;
  73.  
  74. procedure WaitRetrace;assembler;
  75. asm
  76.   mov     dx,3DAh
  77. @1:
  78.   in      al,dx
  79.   and     al,8
  80.   jz      @1
  81. @2:
  82.   in      al,dx
  83.   and     al,8
  84.   jz      @2
  85. end;
  86.  
  87. procedure SetPal(col,r,g,b:byte);assembler;
  88. asm
  89.   mov     dx,3C8h
  90.   mov     al,col
  91.   out     dx,al
  92.   inc     dx
  93.   mov     al,r
  94.   out     dx,al
  95.   mov     al,g
  96.   out     dx,al
  97.   mov     al,b
  98.   out     dx,al
  99. end;
  100.  
  101.  
  102. begin
  103.   randomize;            { Zufallsgenerator anwerfen }
  104.   InitStars;            { Sternenarrays mit Werten füllen }
  105.   asm mov ax,13h; int 10h end; { VGA Modus setzen }
  106.   for n := 0 to 63 do SetPal(n,n,n,n); { Palette setzen }
  107.   ZAdd := -4;           { ZAdd initialisieren }
  108.   repeat
  109.     MoveStars;          { Sterne bewegen }
  110.     Backup := Stars2D;  { Alte Sternpositionen sichern }
  111.     Calc_2Dto3D;        { und neue berechnen }
  112.     WaitRetrace;        { Auf Retrace warten }
  113.     ClearStars;         { Alte Sterne löschen }
  114.     DrawStars;          { und neue zeichnen }
  115.   until keypressed;
  116.   readkey;
  117.   asm mov ax,3; int 10h end;
  118. end.
  119.